home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 002 / bibloghy.arc / BUILD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-06-17  |  4.1 KB  |  168 lines
  1. {$debug-,$ocode-}
  2.  
  3. program build (output,infile,outfile);
  4.  
  5. var
  6.   infile, outfile : text;
  7.   done            : boolean;
  8.   items_in        : word;
  9.   items_out       : word;
  10.   column          : word;
  11.   max             : word;
  12.   average         : word;
  13.   refcount        : word;
  14.   inline          : lstring (99);
  15.   prior_item      : lstring (99);
  16.   up_item         : lstring (99);
  17.   up_prior_item   : lstring (99);
  18.   item            : lstring (99);
  19.   maxitem         : lstring (99);
  20.   number          : lstring (99);
  21.   
  22.  
  23. procedure initialize;
  24.   begin
  25.     writeln;
  26.     writeln ('Index building program, (C) Copyright Peter Norton 1983');
  27.     writeln;
  28.     done := false;
  29.     items_in := 0;
  30.     items_out := 0;
  31.     column    := 0;
  32.     max       := 0;
  33.     refcount  := 0;
  34.     maxitem   := null;
  35.     prior_item := ' ';
  36.     prior_item [1] := chr (0);
  37.     up_prior_item := ' ';
  38.     up_prior_item [1] := chr (0);
  39.     reset   (infile);
  40.     rewrite (outfile);
  41.   end;
  42.  
  43. procedure finish_up;
  44.   begin
  45.     writeln;
  46.     writeln;
  47.     writeln (items_in, ' individual references in');
  48.     writeln (items_out,' separate index entries out');
  49.     writeln (max,      ' greatest number of references, to ',maxitem);
  50.     if items_out  = 0 then
  51.       items_out  := 1;
  52.     average := items_in div items_out;
  53.     if ((items_in mod items_out) * 2) >= items_out then
  54.       average := average + 1;
  55.     writeln (average,  ' average references per index entry');
  56.   end;
  57.  
  58. function digest : boolean;
  59.   var [static]
  60.     start, stop, i : word;   
  61.   begin
  62.     if inline.len < 7 then
  63.       begin
  64.         for i := 1 to inline.len do
  65.           if inline [i] <> ' ' then
  66.             begin
  67.               writeln (chr(7));
  68.               writeln;
  69.               writeln ('Invalid input line: "',inline,'"');
  70.               writeln;
  71.               break;
  72.             end;
  73.         digest := false;
  74.         return;
  75.       end;
  76.     if inline [7] <> '=' then
  77.       begin
  78.         writeln (chr(7));
  79.         writeln;
  80.         writeln ('Invalid input line: "',inline,'"');
  81.         writeln;
  82.         digest := false;
  83.         return;
  84.       end;
  85.     digest := true;
  86.     start := 1;
  87.     for i := 1 to 5 do
  88.       if inline [i] = '0' then
  89.         start := i + 1
  90.       else
  91.         break;
  92.     stop := 6;
  93.     for i := 6 downto 2 do
  94.       if inline [i] = ' ' then
  95.         stop := i - 1
  96.       else
  97.         break;
  98.     number := null;
  99.     for i := start to stop do
  100.       begin
  101.         number.len := number.len + 1;
  102.         number [number.len] := inline [i];
  103.       end;
  104.     item := null;
  105.     for i := 8 to inline.len do
  106.       begin
  107.         item.len := item.len + 1;
  108.         item [i-7] := inline [i];
  109.       end;
  110.     up_item := item;
  111.     for i := 1 to up_item.len do
  112.       if up_item [i] in ['a'..'z'] then
  113.          up_item [i] := chr (ord(up_item [i]) - 32);
  114.   end;
  115.  
  116. procedure process_line;
  117.   begin
  118.     readln (infile,inline);
  119.     if not digest then
  120.       return;
  121.     items_in := items_in + 1;
  122.     if up_item = up_prior_item then
  123.       begin
  124.         write (output, ', ');
  125.         write (outfile,', ');
  126.         column := column + 2;
  127.       end
  128.     else
  129.       begin
  130.         if refcount > max then
  131.           begin
  132.             max := refcount;
  133.             maxitem := prior_item;
  134.           end;
  135.         refcount := 0;
  136.         prior_item := item;
  137.         up_prior_item := up_item;
  138.         items_out := items_out + 1;
  139.         writeln (output);
  140.         writeln (outfile);
  141.         writeln (output);
  142.         writeln (outfile);
  143.         write   (output, item);
  144.         write   (outfile,item);
  145.         write   (output, ' ');
  146.         write   (outfile,' ');
  147.         column := item.len + 1;
  148.       end;
  149.     if column > 72 then
  150.       begin
  151.         column := 5;
  152.         writeln (output);
  153.         writeln (outfile);
  154.         write   (output, ' ':5);
  155.         write   (outfile,' ':5);
  156.       end;
  157.     write (output, number);
  158.     write (outfile,number);
  159.     refcount := refcount + 1;
  160.     column := column + number.len;
  161.   end;
  162.  
  163. begin
  164.   initialize;
  165.   while not eof (infile) do
  166.     process_line;
  167.   finish_up;
  168. end.